home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / SORT_UTL / SORTIN / DISTSORT.PAS next >
Pascal/Delphi Source File  |  1988-12-25  |  2KB  |  64 lines
  1. unit DistSort;
  2. {=============================================}
  3. {            James L. Allison                 }
  4. {            1703 Neptune Lane                }
  5. {            Houston, Texas  77062            }
  6. {            Dec 22, 1988                     }
  7. {=============================================}
  8.  
  9. { Please feel free to use any part of this in any of your programs.}
  10. interface
  11.    uses TypeSpec,Sorting;
  12.  
  13. procedure DistributionSort(var X:List; N:integer);
  14. {  This is a real screamer, but it takes a lot of space,
  15.    and is hard to package for inclusion in a library.  It
  16.    requires prior knowledge of how the array and keys are structured.
  17.    It is only feasible where there are a small number of possible
  18.    keys.  In this example, there are only 256 different values.
  19.    It works well, for example, where the key is sex, department
  20.    or state.  It would be a disaster if the keys were name or
  21.    phone number.
  22.  
  23.    The strategy is to copy the array into a save area, and count
  24.    the number of each key present.  The original array is then
  25.    marked off into bins of the appropriate size.  After that, the
  26.    records are copied (like dealing cards) into the proper bin.  }
  27. (*---------------------------------------------------------------------*)
  28.  
  29. implementation
  30.  
  31. (*---------------------------------------------------------------------*)
  32. procedure DistributionSort(var X:List; N:integer);
  33. var
  34.    Bins,Start:array[byte] of integer;
  35.    I,Pos:integer;
  36.    Save:Screen_Buffer;
  37.    begin
  38.       for I:=0 to 255 do Bins[I]:=0;
  39.       Start:=Bins;
  40.  
  41.       for I:=0 to N-1 do          {copy array to scratch area}
  42.       begin
  43.          Save[I]:=X[I];
  44.          inc (Bins[X[I][Value]]); {count the number of each key value}
  45.       end;
  46.  
  47.       Pos:=0;
  48.       for I:=1 to 255 do
  49.       begin
  50.          inc(Pos,Bins[I-1]);      {compute the start position of each bin}
  51.          Start[I]:=Pos;
  52.       end;
  53.  
  54.       for I:=0 to N-1 do          {deal the saved array back to the original}
  55.       begin
  56.          X[Start[Save[I][Value]]]:=Save[I];
  57.          inc(Start[Save[I][Value]]);
  58.       end;
  59.  
  60.    end;
  61.  
  62.    begin
  63.    end.
  64.